home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / internet / vbipsmtp / brainded.frm < prev    next >
Text File  |  1996-03-09  |  11KB  |  350 lines
  1. VERSION 4.00
  2. Begin VB.Form frmBrainDead 
  3.    Caption         =   "Brain Dead SMTP Example"
  4.    ClientHeight    =   5700
  5.    ClientLeft      =   885
  6.    ClientTop       =   840
  7.    ClientWidth     =   7680
  8.    Height          =   6105
  9.    Icon            =   "brainded.frx":0000
  10.    Left            =   825
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   5700
  14.    ScaleWidth      =   7680
  15.    Top             =   495
  16.    Width           =   7800
  17.    Begin VB.TextBox txtSubject 
  18.       BeginProperty Font 
  19.          name            =   "MS Sans Serif"
  20.          charset         =   0
  21.          weight          =   400
  22.          size            =   9.75
  23.          underline       =   0   'False
  24.          italic          =   0   'False
  25.          strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   420
  28.       Left            =   1935
  29.       TabIndex        =   10
  30.       Top             =   1800
  31.       Width           =   5595
  32.    End
  33.    Begin VB.TextBox txtTo 
  34.       BeginProperty Font 
  35.          name            =   "MS Sans Serif"
  36.          charset         =   0
  37.          weight          =   400
  38.          size            =   9.75
  39.          underline       =   0   'False
  40.          italic          =   0   'False
  41.          strikethrough   =   0   'False
  42.       EndProperty
  43.       Height          =   420
  44.       Left            =   1935
  45.       TabIndex        =   8
  46.       Top             =   1260
  47.       Width           =   3750
  48.    End
  49.    Begin VB.TextBox txtFrom 
  50.       BeginProperty Font 
  51.          name            =   "MS Sans Serif"
  52.          charset         =   0
  53.          weight          =   400
  54.          size            =   9.75
  55.          underline       =   0   'False
  56.          italic          =   0   'False
  57.          strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   420
  60.       Left            =   1935
  61.       TabIndex        =   6
  62.       Top             =   720
  63.       Width           =   3750
  64.    End
  65.    Begin VB.TextBox txtServer 
  66.       BeginProperty Font 
  67.          name            =   "MS Sans Serif"
  68.          charset         =   0
  69.          weight          =   400
  70.          size            =   9.75
  71.          underline       =   0   'False
  72.          italic          =   0   'False
  73.          strikethrough   =   0   'False
  74.       EndProperty
  75.       Height          =   420
  76.       Left            =   1935
  77.       TabIndex        =   3
  78.       Top             =   180
  79.       Width           =   3750
  80.    End
  81.    Begin VB.TextBox Text1 
  82.       BeginProperty Font 
  83.          name            =   "MS Sans Serif"
  84.          charset         =   0
  85.          weight          =   400
  86.          size            =   9.75
  87.          underline       =   0   'False
  88.          italic          =   0   'False
  89.          strikethrough   =   0   'False
  90.       EndProperty
  91.       Height          =   3120
  92.       Left            =   135
  93.       MultiLine       =   -1  'True
  94.       ScrollBars      =   2  'Vertical
  95.       TabIndex        =   2
  96.       Top             =   2430
  97.       Width           =   7440
  98.    End
  99.    Begin VB.CommandButton btnSend 
  100.       Caption         =   "&Send"
  101.       BeginProperty Font 
  102.          name            =   "MS Sans Serif"
  103.          charset         =   0
  104.          weight          =   400
  105.          size            =   9.75
  106.          underline       =   0   'False
  107.          italic          =   0   'False
  108.          strikethrough   =   0   'False
  109.       EndProperty
  110.       Height          =   735
  111.       Left            =   5985
  112.       TabIndex        =   1
  113.       Top             =   180
  114.       Width           =   1545
  115.    End
  116.    Begin VB.Label Label1 
  117.       Alignment       =   1  'Right Justify
  118.       Caption         =   "Subject:"
  119.       BeginProperty Font 
  120.          name            =   "MS Sans Serif"
  121.          charset         =   0
  122.          weight          =   400
  123.          size            =   9.75
  124.          underline       =   0   'False
  125.          italic          =   0   'False
  126.          strikethrough   =   0   'False
  127.       EndProperty
  128.       Height          =   300
  129.       Index           =   3
  130.       Left            =   90
  131.       TabIndex        =   9
  132.       Top             =   1845
  133.       Width           =   1785
  134.    End
  135.    Begin VB.Label Label1 
  136.       Alignment       =   1  'Right Justify
  137.       Caption         =   "To:"
  138.       BeginProperty Font 
  139.          name            =   "MS Sans Serif"
  140.          charset         =   0
  141.          weight          =   400
  142.          size            =   9.75
  143.          underline       =   0   'False
  144.          italic          =   0   'False
  145.          strikethrough   =   0   'False
  146.       EndProperty
  147.       Height          =   300
  148.       Index           =   2
  149.       Left            =   90
  150.       TabIndex        =   7
  151.       Top             =   1305
  152.       Width           =   1785
  153.    End
  154.    Begin VB.Label Label1 
  155.       Alignment       =   1  'Right Justify
  156.       Caption         =   "From:"
  157.       BeginProperty Font 
  158.          name            =   "MS Sans Serif"
  159.          charset         =   0
  160.          weight          =   400
  161.          size            =   9.75
  162.          underline       =   0   'False
  163.          italic          =   0   'False
  164.          strikethrough   =   0   'False
  165.       EndProperty
  166.       Height          =   300
  167.       Index           =   1
  168.       Left            =   90
  169.       TabIndex        =   5
  170.       Top             =   765
  171.       Width           =   1785
  172.    End
  173.    Begin VB.Label Label1 
  174.       Alignment       =   1  'Right Justify
  175.       Caption         =   "SMTP Gateway:"
  176.       BeginProperty Font 
  177.          name            =   "MS Sans Serif"
  178.          charset         =   0
  179.          weight          =   400
  180.          size            =   9.75
  181.          underline       =   0   'False
  182.          italic          =   0   'False
  183.          strikethrough   =   0   'False
  184.       EndProperty
  185.       Height          =   300
  186.       Index           =   0
  187.       Left            =   90
  188.       TabIndex        =   4
  189.       Top             =   225
  190.       Width           =   1770
  191.    End
  192.    Begin dsSocketLib.dsSocket DSSocket1 
  193.       Height          =   420
  194.       Left            =   6885
  195.       TabIndex        =   0
  196.       Top             =   1125
  197.       Width           =   420
  198.       _version        =   65542
  199.       _extentx        =   741
  200.       _extenty        =   741
  201.       _stockprops     =   64
  202.       localport       =   0
  203.       remotehost      =   ""
  204.       remoteport      =   0
  205.       servicename     =   ""
  206.       remotedotaddr   =   ""
  207.       linger          =   -1  'True
  208.       timeout         =   10
  209.       linemode        =   0   'False
  210.       eolchar         =   10
  211.       bindconnect     =   0   'False
  212.       sockettype      =   0
  213.    End
  214. End
  215. Attribute VB_Name = "frmBrainDead"
  216. Attribute VB_Creatable = False
  217. Attribute VB_Exposed = False
  218. Option Explicit
  219. '---------------------------------------------------
  220. 'BRAINDED.FRM
  221. 'Copyright 1996 by Carl Franklin
  222. 'Unauthorized reproduction in any medium of this
  223. 'source code is strictly prohibited without written
  224. 'permission from the author and John Wiley & Sons.
  225. '---------------------------------------------------
  226.  
  227. Dim nConnected As Integer
  228. Const SOCK_ACTION_CONNECT = 2
  229. Const SOCK_ACTION_CLOSE = 1
  230. Private Sub btnSend_Click()
  231.  
  232.     '-- Temporarily disable the button
  233.     Screen.MousePointer = vbHourglass
  234.     btnSend.Enabled = False
  235.     
  236.     '-- SMTP uses port 25
  237.     DSSocket1.RemotePort = 25
  238.  
  239.  
  240.     '-- Is this a DOT address?
  241.     If IsDotAddress(Text1) Then
  242.         '-- Yes. Use the RemoteDotAddr property
  243.         DSSocket1.RemoteDotAddr = txtServer
  244.     Else
  245.         '-- No. Use the RemoteHost property
  246.         DSSocket1.RemoteHost = txtServer
  247.     End If
  248.     
  249.     '-- Try to connect
  250.     nConnected = False
  251.     On Error Resume Next
  252.     DSSocket1.Action = SOCK_ACTION_CONNECT
  253.     If Err Then
  254.         '-- Error!
  255.         MsgBox Error, vbInformation
  256.     Else
  257.         '-- Wait until we've connected
  258.         Do
  259.             DoEvents
  260.         Loop Until nConnected
  261.         '-- Send the email
  262.         SendBrainDead DSSocket1, (txtFrom), (txtTo), (txtSubject), (Text1)
  263.         '-- Close the port and beep as an indicator
  264.         DSSocket1.Action = SOCK_ACTION_CLOSE
  265.         Beep
  266.     End If
  267.     
  268.     '-- Re-enable stuff
  269.     Screen.MousePointer = vbNormal
  270.     btnSend.Enabled = True
  271.     
  272. End Sub
  273.  
  274. Function IsDotAddress(szAddress As String) As Integer
  275.  
  276.     '-- This function determines if a string is an IP address like
  277.     '   199.200.199.120 or not
  278.  
  279.     Dim nPos As Integer
  280.     Dim nIndex As Integer
  281.     Dim szSection As String
  282.     Dim szTemp As String
  283.  
  284.     szTemp = szAddress
  285.     szAddress = Trim$(szAddress)
  286.  
  287.     For nIndex = 1 To 3
  288.         nPos = InStr(szAddress, ".")
  289.         If nPos Then
  290.             szSection = Left$(szAddress, nPos - 1)
  291.             If Len(szSection) = 0 Then
  292.                 Exit Function
  293.             ElseIf Trim$(Str$(Val(szSection))) <> szSection Then
  294.                 Exit Function
  295.             ElseIf Val(szSection) > 255 Then
  296.                 Exit Function
  297.             ElseIf Val(szSection) < 0 Then
  298.                 Exit Function
  299.             End If
  300.             szAddress = Mid$(szAddress, nPos + 1)
  301.         Else
  302.             Exit Function
  303.         End If
  304.     Next
  305.  
  306.     If Len(szAddress) = 0 Then
  307.         Exit Function
  308.     ElseIf Trim$(Str$(Val(szAddress))) <> szAddress Then
  309.         Exit Function
  310.     ElseIf Val(szAddress) > 255 Then
  311.         Exit Function
  312.     ElseIf Val(szAddress) < 0 Then
  313.         Exit Function
  314.     End If
  315.  
  316.     szAddress = szTemp
  317.     IsDotAddress = True
  318.  
  319. End Function
  320.  
  321.  
  322. Private Sub DSSocket1_Connect()
  323.     
  324.     nConnected = True
  325.  
  326. End Sub
  327.  
  328. Sub SendBrainDead(DSSock As Control, szFrom As String, szTo As String, szSubject As String, szMsg As String)
  329. '-- This routine sends an email message via an SMTP gateway.
  330.  
  331.     Dim szCRLF As String
  332.     Dim szCompleteMsg As String
  333.  
  334.     '-- All lines end with a CR/LF Pair
  335.     szCRLF = Chr$(13) & Chr$(10)
  336.  
  337.     szCompleteMsg = "MAIL FROM: <" & szFrom & ">" & szCRLF _
  338.        & "RCPT TO: <" & szTo & ">" & szCRLF _
  339.        & "DATA" & szCRLF _
  340.        & "DATE: " & Format$(Now, "dd mmm yy ttttt") & szCRLF _
  341.        & "FROM: " & szFrom & szCRLF _
  342.        & "TO: " & szTo & szCRLF _
  343.        & "SUBJECT: " & szSubject & szCRLF & szCRLF _
  344.        & szMsg & szCRLF & "." & szCRLF
  345.  
  346.     DSSock.Send = szCompleteMsg
  347.     
  348. End Sub
  349.  
  350.